home *** CD-ROM | disk | FTP | other *** search
/ ASP Advantage 1993 / The Association of Shareware Professionals Advantage CD-ROM 1993.iso / files / commions / ca29_1 / ca29_3.exe / BBMAINT4.CMD < prev    next >
OS/2 REXX Batch file  |  1992-03-24  |  35KB  |  1,195 lines
  1. ;****    TRACE ON        ; Debugging
  2. ;
  3. ; ----- COM-AND BBS file maintenance script (MAIL file)
  4. ;    Commenced: 11/90 R.McG
  5. ; -----------------------------------------------------------------------
  6. ;    Purpose:
  7. ;       The script, named BBMAINT4.CMD, produces the main window for
  8. ;    Mail functions of BBMAINT, and implements its functions.  It is
  9. ;    not directly callable itself.
  10. ; -----------------------------------------------------------------------
  11. ;    Usage:
  12. ;       N99 -> Text attribute value (Setup by BBMAINT.CMD)
  13. ;       N98 -> BBMAINT Mainline cursor position
  14. ;       N97 -> BBMAINT Mainline cursor position
  15. ;       N96 -> our mainline cursor position
  16. ;       N95 -> our mainline cursor position
  17. ; -----------------------------------------------------------------------
  18. ;
  19. ;    This script is intended ONLY to be used for FCALL
  20. ;
  21.     IF NOT FCALLED
  22.        WOPEN 10,10,13,70 (cont) NOMAEsc
  23.        ATSAY 10,12 (cont) " BBS Mail "
  24.        ATSAY 11,12 (cont) " The script: "*"_SCRIPT"
  25.        ATSAY 12,12 (cont) " is not used by itself... it is called through BBMAINT"
  26.        ATSAY 13,26 (cont) " Press any key to continue "
  27.        ;
  28.        ;    Wait a keypress
  29.        ;
  30.        KEYGET S0        ; Wait for any key
  31.        WCLOSE        ; Close open window
  32.        EXIT         ; Terminate right here
  33.        ENDIF
  34.     GOSUB Mailfile        ; Invoke function
  35.     FRETURN         ; Return to caller
  36. ; -----------------------------------------------------------------------
  37. ; ----- NoMail:  Inform that there's no BBS-Mail file to modify
  38. ;
  39. NoMail:
  40.     WOPEN 10,10,13,70 (cont) NOMAEsc
  41.     ATSAY 10,12 (cont) " BBS MailDir "
  42.     ATSAY 11,12 (cont) " The file: "*S24&"\BBS-Mail"
  43.     ATSAY 12,12 (cont) " does not exist.  Please create subdirectories first."
  44.     ATSAY 13,26 (cont) " Press any key to continue "
  45.     ;
  46.     ;    Wait a keypress
  47.     ;
  48.     KEYGET S0        ; Wait for any key
  49.     WCLOSE
  50. NOMAEsc:
  51.     RETURN
  52. ; -----------------------------------------------------------------------
  53. ; ----- Subroutine: MailFile -> Update Mail directory
  54. ;
  55. MailFile:
  56.     GOSUB NewMail        ; Create if not there
  57.     IF NOT ISFILE S24&"\BBS-Mail"
  58.        GOSUB NoMail     ; Inform there's no file
  59.        RETURN        ; .. so we can't continue
  60.        ENDIF
  61. ;
  62. ;    Open a new window
  63. ;
  64.     WOPEN 0,0 23,79 (defa) Mail_Esc
  65.     ATSAY 0,2 (defa)   " BBS Mail "
  66.     ATSAY 23,25 (defa) " Press ESC to cancel BBMAINT "
  67. ;
  68. ;    Paint a new menu
  69. ;
  70. MAFI100:
  71.     CLEAR            ; Clear window
  72.     LOCATE 2,2
  73.  
  74.     MESS " 1) Clean up mail directory"
  75.     MESS " 2) Delete notes older than ..."
  76.     MESS " 3) Read notes newer than ..."
  77.     MESS " 4) Post a new note"
  78.     MESS "──────────────────────────────────── "
  79.     MESS "Note: Alt-Q to edit a file"
  80.     MESS "      Alt-F for a directory search"
  81.     MESS "      Alt-F10 to shell to DOS"
  82.     MESS " "
  83.     MESS "──────────────────────────────────── "
  84.     MESS " "
  85.     MESS "Select item (carriage return = previous): "
  86.     CURSOR N96,N95        ; Read current cursor
  87. ;
  88. ;    Wait for entry, and interpret
  89. ;
  90. MAFI200:
  91.     LOCATE N96 N95        ; Reposition cursor
  92.     KEYGET S0        ; Wait for it
  93.     SWITCH S0        ; Act according to keyget
  94.       CASE "1"
  95.            GOSUB ClrMail
  96.            GOTO MAFI100    ; Repaint after this
  97.            ENDCASE
  98.       CASE "2"
  99.            GOSUB DelMail
  100.            GOTO MAFI100    ; Repaint after this
  101.            ENDCASE
  102.       CASE "3"
  103.            GOSUB ReadMail
  104.            GOTO MAFI100    ; Repaint after this
  105.            ENDCASE
  106.       CASE "4"
  107.            GOSUB Compose
  108.            GOTO MAFI200    ; This sub saves screen
  109.            ENDCASE
  110.       CASE "0d"             ; c/r alone is exit
  111.            WCLOSE        ; Close window...
  112.            RETURN        ; and return to caller
  113.            ENDCASE
  114.       CASE "_NULL"          ; ESC -> Null
  115.            WCLOSE        ; Close window...
  116.            RETURN        ; Leave Main routine
  117.            ENDCASE
  118.       CASE "2100"           ; Alt-F
  119.            MANUAL "0x2100"  ; Perform Dir cmd
  120.            ENDCASE
  121.       CASE "1000"           ; Alt-Q
  122.            MANUAL "0x1000"  ; Edit a file
  123.            ENDCASE
  124.       CASE "7100"           ; Alt-F10
  125.            SHELL
  126.            DWINDOW 1,2,22,78; Reset dwindow after shell
  127.            LEGEND "_LEGEND" ; Redo the legend
  128.            ENDCASE
  129.       DEFAULT        ; None of the above
  130.            SOUND 100,100    ; Bronx cheer
  131.            ENDCASE
  132.       ENDSWITCH
  133.     GOTO MAFI200        ; Repaint screen and ask again
  134. ;
  135. ;    End of mail procedure
  136. ;
  137. Mail_Esc:
  138.     S0 = ""                 ; Fake a null entry
  139.     RETURN            ; Leave Mail routine
  140. ; -----------------------------------------------------------------------
  141. ; ----- ClrMail:  Clear mail directory of unneeded entries
  142. ;
  143. ClrMail:
  144.     FOPENI S24&"\BBS-Mail" TEXT
  145.     IF NOT SUCCESS        ; Open failed
  146.        S0 = "Error opening: "*S24&"\BBS-Mail"
  147.        GOSUB Error        ; Report
  148.        RETURN        ; And we're done
  149.        ENDIF
  150.  
  151.     FOPENO S24&"\TempMail" TEXT
  152.     IF NOT SUCCESS        ; Open failed
  153.        S0 = "Error opening: "*S24&"\TempMail"
  154.        GOSUB Error        ; Report
  155.        RETURN        ; And we're done
  156.        ENDIF
  157. ;
  158. ;    Initialize
  159. ;
  160.     CLEAR            ; Clear window
  161.     N9 = 0            ; Count recs written
  162. ;
  163. ;    Read loop (40 chars at a time to allow PRESERVE)
  164. ;
  165. CLMA100:
  166.     READ S10 40 N0        ; Read a record
  167.     IF EOF GOTO CLMA200    ; Skip on EOF
  168.     IF STRCMP S10(0:0) "*" GOTO CLMA115 ; Copy comments
  169.     IF ZERO N0 GOTO CLMA115 ; Copy blank lines
  170. ;
  171. ;    Test for the existence of the indicated file
  172. ;
  173. CLMA110:
  174.     S0 = S24&"\"*S10(25:37) ; Make a file name
  175.     IF NOT ISFILE S0    ; Test existence
  176.        MESS S0*" does not exist - deleting record"
  177.        GOTO CLMA130     ; Remove entry
  178.        ENDIF
  179.     MESS S0*" exists - copying record"
  180. ;
  181. ;    Count the write
  182. ;
  183. CLMA115:
  184.     INC N9            ; Count recs written
  185. ;
  186. ;    Copy record just read to output file
  187. ;
  188. CLMA120:
  189.     PRESERVE S10        ; Save !'s and ^'s
  190.     WRITE S10        ; Write text
  191.  
  192.     IF N0 LT 40        ; If we wrote end of record
  193.        WRITE "!"            ; Finish w/cr/lf
  194.        GOTO CLMA100     ; And continue copying
  195.        ENDIF
  196.     READ S10 40 N0        ; Read remainder of rec
  197.     IF NOT EOF GOTO CLMA120 ; Skip if not eof
  198.     WRITE "!"               ; Finish record
  199.     GOTO CLMA200        ; End of file
  200. ;
  201. ;    Throw away the current record
  202. ;
  203. CLMA130:
  204.     IF N0 LT 40 GOTO CLMA100
  205.     READ S10 40 N0         ; Read remainder of rec
  206.     IF NOT EOF GOTO CLMA130 ; Skip if not eof
  207. ;
  208. ;    We have end-of-file
  209. ;
  210. CLMA200:
  211.     WRITE "^Z"              ; Finish ASCII file
  212.     FCLOSEO         ; Close output
  213.     FCLOSEI         ; Close input
  214.     DELETE S24&"\BBS-Mail"  ; Delete original
  215.     RENAME S24&"\TempMail" S24&"\BBS-Mail"
  216.     IF ZERO N9 DELETE S24&"\BBS-Mail" ; Delete empty file
  217.     RETURN
  218. ; -----------------------------------------------------------------------
  219. ; ----- DelMail:  Delete mail files older than some date...
  220. ;    .. Note this only works through current and last year
  221. ;
  222. DelMail:
  223.     FOPENI S24&"\BBS-Mail" TEXT
  224.     IF NOT SUCCESS        ; Open failed
  225.        S0 = "Error opening: "*S24&"\BBS-Mail"
  226.        GOSUB Error        ; Report
  227.        RETURN        ; And we're done
  228.        ENDIF
  229.  
  230.     FOPENO S24&"\TempMail" TEXT
  231.     IF NOT SUCCESS        ; Open failed
  232.        S0 = "Error opening: "*S24&"\TempMail"
  233.        GOSUB Error        ; Report
  234.        GOTO DEMAErr     ; And we're done
  235.        ENDIF
  236.     N9 = 0            ; Counter for recs written
  237. ;
  238. ;    Initialize
  239. ;    .. (N2 = # days to keep, N3 = today's julian dayno, N4 = current yr)
  240. ;
  241.     S0 = "Enter age in days of the oldest file to keep"
  242.     GOSUB Get_Number    ; Ask for a value
  243.     IF FLAG(0) GOTO DEMAERR ; IF ESCAPE pressed...
  244.     IF N0 LE 0 N0 = 1    ; No negative dates
  245.     N2 = N0         ; Save value for later
  246.  
  247.     DATE S0 1        ; get current date (mm/dd/yyyy)
  248.     N4 = S0(6:9)        ; Save current year number
  249.     GOSUB Julian        ; make Julian date from current date
  250.     N3 = N0         ; Save current julian day number
  251.  
  252.     CLEAR            ; Clear window
  253. ;
  254. ;    Read loop (40 chars at a time to allow PRESERVE)
  255. ;
  256. DEMA100:
  257.     READ S10 40 N10     ; Read a record
  258.     IF EOF GOTO DEMA200    ; Skip on EOF
  259.     IF STRCMP S10(0:0) "*" GOTO DEMA115 ; Copy comments
  260.     IF ZERO N10 GOTO DEMA115; Copy blank lines
  261. ;
  262. ;    Test for the existence of the indicated file
  263. ;
  264. DEMA110:
  265.     S1 = S24&"\"*S10(25:37) ; Make a file name
  266.     IF NOT ISFILE S1    ; Test existence
  267.        MESS S1*" does not exist - cleaning dir"
  268.        GOTO DEMA130     ; Remove entry
  269.        ENDIF
  270. ;
  271. ;    Find the date of the file.  NOTE: The years we limit this code
  272. ;    .. to recognizing are the current and previous years.
  273. ;
  274.     FDATE S0 S1 1        ; Get the file's date into S0 (mm/dd/yyyy)
  275.     N5 = N4-S0(6:9)     ; Compute # years difference fdate and cur yr
  276.     IF N5 LT 0        ; If file year is future....
  277.        MESS S1*" date is in the future... saving(!!)"
  278.        GOTO DEMA115     ; Save the entry
  279.        ENDIF
  280.     IF N5 GT 1        ; if file older than 1 year
  281.        MESS S1*" more than a year old ... deleting"
  282.        DELETE S1        ; Delete the file...
  283.        GOTO DEMA130     ; Delete the entry
  284.        ENDIF
  285.     GOSUB Julian        ; Convert date to Julian day no
  286. ;
  287. ;    Compute the days difference and act according to user set max
  288. ;
  289.     IF N5 EQ 0        ; if file date same year as current...
  290.        N1 = N3-N0        ; Same year... N1 = age of file
  291.     ELSE            ; If file date previous year
  292.        N1 = N3-(N1-N0)    ; [Julian returns N1 = #days that year]
  293.        ENDIF
  294.     IF N1 GT N2        ; If fileage > max age
  295.        MESS S1*" is "*N1*" days old - deleting"
  296.        DELETE S1        ; Delete the file...
  297.        GOTO DEMA130     ; Delete the entry
  298.        ENDIF
  299.     MESS S1*" is "*N1*" days old - keeping"
  300. ;
  301. ;    Count the write
  302. ;
  303. DEMA115:
  304.     INC N9            ; Count recs written
  305. ;
  306. ;    Copy record just read to output file
  307. ;
  308. DEMA120:
  309.     PRESERVE S10        ; Save !'s and ^'s
  310.     WRITE S10        ; Write text
  311.  
  312.     IF N10 LT 40        ; If we wrote end of record
  313.        WRITE "!"            ; Finish w/cr/lf
  314.        GOTO DEMA100     ; And continue copying
  315.        ENDIF
  316.     READ S10 40 N10     ; Read remainder of rec
  317.     IF NOT EOF GOTO DEMA120 ; Skip if not eof
  318.     WRITE "!"               ; Finish record
  319.     GOTO DEMA200        ; End of file
  320. ;
  321. ;    Throw away the current record
  322. ;
  323. DEMA130:
  324.     IF N10 LT 40 GOTO DEMA100
  325.     READ S10 40 N10     ; Read remainder of rec
  326.     IF NOT EOF GOTO DEMA130 ; Skip if not eof
  327. ;
  328. ;    We have end-of-file
  329. ;
  330. DEMA200:
  331.     WRITE "^Z"              ; Finish ASCII file
  332.     FCLOSEO         ; Close output
  333.     FCLOSEI         ; Close input
  334.     DELETE S24&"\BBS-Mail"  ; Delete original
  335.     RENAME S24&"\TempMail" S24&"\BBS-Mail"
  336.     IF ZERO N9 DELETE S24&"\BBS-Mail" ; Delete empty file
  337.     RETURN
  338. ;
  339. ;    Error exit
  340. ;
  341. DEMAERR:
  342.     FCLOSEO         ; Close output
  343.     FCLOSEI         ; Close input
  344.     RETURN
  345. ; -------------------------------------------------------------------------
  346. ; ----- Get_Number
  347. ;    S0 passes the prompt
  348. ;    N0 returns the value entered
  349. ;    FLAG(0) returned true indicates ESC was pressed
  350. ;
  351. Get_Number:
  352.     SET FLAG(0) OFF     ; ESCAPE flag
  353.     WOPEN 10,10,13,70 (cont) GENU_ESC
  354.     ATSAY 10,12 (cont) " Enter Value "
  355.     ATSAY 11,12 (cont) S0(0:55); Max msg width 55 chars
  356.     ATSAY 12,12 (cont) "-> "
  357.     ATSAY 13,26 (cont) " Press ESCAPE to cancel "
  358.     N0 = -1         ; Default value
  359.     ;
  360.     ;    Wait a keypress
  361.     ;
  362. GENU100:
  363.     LOCATE 12,15
  364.     GET S0 5        ; Wait for a number
  365.     IF NOT FLAG(0) and NOT (FIND S0 "all" or NULL S0)
  366.        ATOI S0 N0        ; Convert w/o err msg
  367.        IF ERROR        ; If couldn't convert
  368.           SOUND 100,100    ; Bronx cheer
  369.           GOTO GENU100    ; Ask again
  370.           ENDIF
  371.     ELSE
  372.        IF NOT (FIND S0 "all" or NULL S0)
  373.           SOUND 100,100    ; Bronx cheer
  374.           GOTO GENU100    ; Ask again
  375.           ENDIF
  376.        ENDIF
  377.     WCLOSE            ; Close open window
  378.     RETURN
  379.     ;
  380.     ;    Escape during GET
  381.     ;
  382. GENU_Esc:
  383.     SET FLAG(0) ON        ; Flag Escape pressed
  384.     RETURN
  385. ; -----------------------------------------------------------------------
  386. ; ----- Subroutine: NewMail -> Create a new BBS-Mail file
  387. ;
  388. NewMail:
  389.     IF ISFILE S24&"\BBS-Mail" RETURN
  390.     FOPENO S24&"\BBS-Mail" TEXT
  391.     IF NOT SUCCESS RETURN    ; Open failed
  392.     WRITE "!^Z"             ; Make it empty
  393.     FCLOSEO         ; Done with it
  394.     RETURN
  395. ;--------------------------------------------------------------------------
  396. ;------ Julian: Simple (not true) Julian date conversion
  397. ;
  398. ;    Passed: S0 contains a date formatted: mm/dd/yyyy left justified
  399. ;        as per COM-AND "DATE Sx 1" format
  400. ;    Rtnd:    N0 returns the julian date number (1-366)
  401. ;        N1 returns 365 or 366 as the total # days in the given year
  402. ;        if SUCCESS is set
  403. ;
  404. ;    NOTE: This routine is placed near beginning of file to speed access.
  405. ;    This script exceeds the 100 label limit of COM-AND's cache!
  406. ;
  407. Julian:
  408.     IF NOT (NUMERIC S0(0) and NUMERIC S0(3) and NUMERIC S0(6)) GOTO JULERR
  409.     N0 = S0(3:4)            ; Extract day number
  410.     N1 = S0(0:1)            ; Set default value to be rtnd
  411.     SWITCH N1            ; Switch on Month #
  412.        CASE 1            ; January
  413.          GOTO JUL200        ; And continue
  414.          ENDCASE
  415.        CASE 2            ; February
  416.          N0 = N0+31         ; Preceeding mo has 31 days
  417.          GOTO JUL200        ; And continue
  418.          ENDCASE
  419.        CASE 3            ; March
  420.          N0 = N0+59         ; Preceeding mo has 28 days
  421.          GOTO JUL100        ; And continue
  422.          ENDCASE
  423.        CASE 4            ; April
  424.          N0 = N0+90         ; Preceeding mo has 31 days
  425.          GOTO JUL100        ; And continue
  426.          ENDCASE
  427.        CASE 5            ; May
  428.          N0 = N0+120        ; Preceeding mo has 30 days
  429.          GOTO JUL100        ; And continue
  430.          ENDCASE
  431.        CASE 6            ; June
  432.          N0 = N0+151        ; Preceeding mo has 31 days
  433.          GOTO JUL100        ; And continue
  434.          ENDCASE
  435.        CASE 7            ; July
  436.          N0 = N0+181        ; Preceeding mo has 30 days
  437.          GOTO JUL100        ; And continue
  438.          ENDCASE
  439.        CASE 8            ; August
  440.          N0 = N0+212        ; Preceeding mo has 31 days
  441.          GOTO JUL100        ; And continue
  442.          ENDCASE
  443.        CASE 9            ; September
  444.          N0 = N0+243        ; Preceeding mo has 31 days
  445.          GOTO JUL100        ; And continue
  446.          ENDCASE
  447.        CASE 10            ; October
  448.          N0 = N0+273        ; Preceeding mo has 30 days
  449.          GOTO JUL100        ; And continue
  450.          ENDCASE
  451.        CASE 11            ; November
  452.          N0 = N0+304        ; Preceeding mo has 31 days
  453.          GOTO JUL100        ; And continue
  454.          ENDCASE
  455.        CASE 12            ; December
  456.          N0 = N0+334        ; Preceeding mo has 30 days
  457.          GOTO JUL100        ; And continue
  458.          ENDCASE
  459.        DEFAULT            ; Month not 1-12
  460.          GOTO JULERR        ; And continue
  461.          ENDCASE
  462.        ENDSWITCH
  463. ;
  464. ;    Month is after February - handle leap year
  465. ;    .. leap year is divisible by 4 but not by 400
  466. ;
  467. JUL100:
  468.     IF (NOT ZERO (S0(6:9)\4)) or ZERO (S0(6:9)\400) GOTO JUL200
  469.     INC N0                ; Add a day for leap year
  470.     N1 = 366            ; Set value to be rtnd (total # days)
  471. ;
  472. ;    Return with a number 1-366 in N0
  473. ;
  474. JUL200:
  475.     IF N1 LT 366 N1 = 365        ; Total # days
  476.     SET SUCCESS ON            ; Indicate success
  477.     RETURN
  478. ;
  479. ;    Error in passed date
  480. ;
  481. JULERR:
  482.     SET SUCCESS OFF         ; Indicate FAILURE
  483.     RETURN
  484. ; -----------------------------------------------------------------------
  485. ; ----- Error:    Open a window, display a message, and wait for keypress
  486. ;    S0 passes the error message
  487. ;
  488. Error:
  489.     WOPEN 10,10,12,70 (cont) Err_Esc
  490.     ATSAY 10,12 (cont) " Error "
  491.     ATSAY 11,12 (cont) S0(0:55); Max msg width 55 chars
  492.     ATSAY 12,26 (cont) " Press any key to continue "
  493.     ;
  494.     ;    Wait a keypress
  495.     ;
  496.     KEYGET S0        ; Wait for any key
  497.     WCLOSE
  498. Err_Esc:
  499.     RETURN
  500. ; -----------------------------------------------------------------------
  501. ; ----- ReadMail:  Read mail files newer than some date...
  502. ;    .. Note this only works through current and last year
  503. ;    Uses: S29,S28,S27,S10
  504. ;
  505. ReadMail:
  506.     FOPENI S24&"\BBS-Mail" TEXT
  507.     IF NOT SUCCESS        ; Open failed
  508.        S0 = "Error opening: "*S24&"\BBS-Mail"
  509.        GOSUB Error        ; Report
  510.        RETURN        ; And we're done
  511.        ENDIF
  512. ;
  513. ;    Alloc dyn vars (for message text display)
  514. ;
  515.     ALLOCATE 100            ; Need 100 dynamic variables
  516.     IF FAILED            ; If allocation failed
  517.        S0 = "Cannot allocate memory for variables"
  518.        GOSUB Error            ; Report the problem
  519.        GOTO REMA900         ; Go clean up
  520.        ENDIF
  521. ;
  522. ;    Initialize
  523. ;    .. (N2 = # days to keep, N3 = today's julian dayno, N4 = current yr)
  524. ;
  525.     S0 = "Enter age in days of the oldest file to read:"
  526.     GOSUB Get_Number    ; Ask for a value
  527.     IF FLAG(0) GOTO REMA900 ; IF ESCAPE pressed...
  528.     N2 = N0         ; Save value for later
  529.  
  530.     DATE S0 1        ; get current date (mm/dd/yyyy)
  531.     N4 = S0(6:9)        ; Save current year number
  532.     GOSUB Julian        ; make Julian date from current date
  533.     N3 = N0         ; Save current julian day number
  534.  
  535.     CLEAR            ; Clear the current screen
  536. ;
  537. ;    Read loop
  538. ;
  539. REMA100:
  540.     FSAVEI            ; Save current place in file
  541.     IF FAILED        ; .. if stack full
  542.        FSAVEI SHIFT     ; .. throw away oldest
  543.        FSAVEI        ; .. and NOW save it
  544.        ENDIF
  545.     READ S10 80 N10     ; Read a record
  546.     IF EOF GOTO REMA900    ; Skip on EOF
  547.     IF STRCMP S10(0:0) "*" GOTO REMA100 ; Skip comments
  548.     IF ZERO N10 GOTO REMA100; Skip blank lines
  549. ;
  550. ;    Test for the existence of the indicated file
  551. ;
  552. REMA110:
  553.     S1 = S24&"\"*S10(25:37) ; Make a file name
  554.     IF NOT ISFILE S1 GOTO REMA100
  555. ;
  556. ;    Skip if 'ALL' selected
  557. ;
  558.     IF N2 LT 0 GOTO REMA200
  559. ;
  560. ;    Find the date of the file.  NOTE: This code limits the years
  561. ;    .. recognized to the current and previous years.
  562. ;
  563.     FDATE S0 S1 1        ; Get the file's date into S0 (mm/dd/yyyy)
  564.     N5 = N4-S0(6:9)     ; Compute # years difference fdate and cur yr
  565.     IF N5 LT 0 GOTO REMA200 ; If file year is future.... read it
  566.     IF N5 GT 1 GOTO REMA100 ; If file older than 1 year skip it
  567.     GOSUB Julian        ; Convert date to Julian day no
  568. ;
  569. ;    Compute the days difference and act according to user set max
  570. ;
  571.     IF N5 EQ 0        ; if file date same year as current...
  572.        N1 = N3-N0        ; Same year... N1 = age of file
  573.     ELSE            ; If file date previous year
  574.        N1 = N3-(N1-N0)    ; [Julian returns N1 = #days that year]
  575.        ENDIF
  576.     IF N1 GT N2 GOTO REMA100; If fileage > max age
  577. ;
  578. ;    Save the current in-file's position and open the mail file
  579. ;
  580. REMA200:
  581.     S29 = "_IPOS"           ; Save input file position as a string
  582.     FOPENI S1 text        ; OPen input file as text
  583.     IF NOT SUCCESS        ; Open failed
  584.        S0 = "Error opening: "*S1
  585.        GOSUB Error        ; Report
  586.        N10 = 0        ; Clear # text lines (to skip display)
  587.        GOTO REMA400     ; And continue
  588.        ENDIF
  589. ;
  590. ;    Load text into dynamic variables
  591. ;
  592.     N10 = 0             ; Clear count of lines
  593.     N11 = 5             ; # header lines to skip
  594.     WHILE NOT EOF and N10 LT 100    ; We have 100 lines possible
  595.           READ S0 80 N0        ; Read a line
  596.           IF NOT EOF and ZERO N11    ; If a line was read...
  597.          PRESERVE S0        ; Retain !s ^s and `s
  598.          V0[N10] = S0        ; Save the line
  599.          INC N10        ; Move to next
  600.          ENDIF
  601.           IF N11 GT 0 DEC N11    ; Count header lines
  602.           ENDWHILE
  603. ;
  604. ;    Re-open the BBS-Mail file and restore its position
  605. ;
  606. REMA400:
  607.     FOPENI S24&"\BBS-Mail" TEXT
  608.     IF NOT SUCCESS        ; Open failed
  609.        S0 = "Error opening: "*S24&"\BBS-Mail"
  610.        GOSUB Error        ; Report
  611.        GOTO REMA900     ; And we're done
  612.        ENDIF
  613.     SET IPOS S29        ; Restore saved position
  614.     LOAD FSAVEI "BBMAINT4.STK"
  615. ;
  616. ;    Display (and prepare relpies to) the note
  617. ;
  618.     IF NOT ZERO N10 GOSUB Display
  619.     IF FLAG(0) GOTO REMA900 ; Exit if ESC
  620.     GOTO REMA100        ; and continue
  621. ;
  622. ;    We have end-of-file
  623. ;
  624. REMA900:
  625.     SET FLAG(0) OFF     ; Clear ESC flag
  626.     FCLOSEI         ; CLose input file
  627.     DEALLOCATE        ; Deallocate variables
  628.     DELETE "BBMAINT4.STK"   ; Delete temp file
  629.     RETURN
  630. ; -----------------------------------------------------------------------
  631. ; ----- Display: Display mail listings
  632. ;
  633. ;    Entry:    S1 -----> File name carrying mail
  634. ;        S10 ----> BBS-Mail record
  635. ;        V0-V99 -> Contain the records to display
  636. ;        N10 ----> Carries the # Vx records
  637. ;    Exit:    FLAG(0) is set to return to main (ESC)
  638. ;    Note:    All values, except N99 may be modified
  639. ;
  640. Display:
  641.     S28 = "_Legend"
  642.     LEGEND "F10 (help), <cr>, PgUp, PgDn"
  643. ;
  644. ;    Save current variables
  645. ;
  646.     S27 = "_ONESCape"               ; Save original handler
  647.     ON ESCAPE GOSUB DispEsc     ; Set new ESC handler
  648. ;
  649. ;    Open a window
  650. ;
  651.     SSIZE N80            ; Get # lines
  652.     SAVE    0,0 N80-2,79        ; Save screen area
  653.     DWINDOW 1,0 N80-3,79        ; Set new DWINDOW
  654.     CLEAR    N99            ; Clear window and set new attr
  655.  
  656.     SET WRAP OFF            ; No line wrap at col 80
  657.     ATSAY    0,0    N99    "▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓"
  658.     ATSAY    N80-2,0 N99    "▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓"
  659.  
  660.     ATSAY 0,2 N99       " BBS Mail "
  661.     S0 = S10(25:37)&""              ; Extract fname
  662.     LENGTH S0 N0            ; get fname length
  663.     ATSAY 0,76-N0 N99      " "*S0&" "
  664.     ATSAY N80-2,25 N99    " Press ESC to return to main "
  665. ;
  666. ;    Display fixed portion
  667. ;
  668.     ATSAY  2,0  N99    "From:    "*S10(8:15)
  669.     ATSAY  3,0  N99    "To:      "*S10(0:7)
  670.     ATSAY  4,0  N99    "Posted:  "*S10(17:24)
  671.  
  672.     ATSAY  5,0  N99    "────────────────────────────────────────────────────────────────────────────"
  673.     ATSAY  6,0  N99    "Subject: "*S10(38:78)
  674.     ATSAY  7,0  N99    "────────────────────────────────────────────────────────────────────────────"
  675. ;
  676. ;    Display text
  677. ;
  678.     N11 = N80-12            ; Compute end line
  679.     IF N11 GE N10 N11 = N10-1    ; ..
  680.     SCREEN 9,0 9+N11,79 N99 V0    ; Display all at once
  681.  
  682.     IF N10 GT N80-11 LEGEND "_LEGEND"&", CurUp, CurDn"
  683. ;
  684. ;    Now, wait for entry
  685. ;
  686. DISP100:
  687.     IF NOT FLAG(0) KEYGET S0    ; Wait for entry
  688.     IF FLAG(0) GOTO DISPXIT     ; Return on ESC
  689.     SWITCH S0            ; Act upon entry
  690.       CASE "0d"                     ; Carriage return
  691.            GOTO DISPXIT        ; Done with display
  692.            ENDCASE
  693.       CASE "5100"                   ; PgDn
  694.            GOTO DISPXIT        ; Done with display
  695.            ENDCASE
  696.       CASE "4900"                   ; PgUp
  697.            S3 = "_IPOS"             ; Read current position
  698.            FRESTOREI        ; Restore current file pos
  699.            IF SUCCESS        ; .. if that worked
  700.           FRESTOREI        ; .. do it again
  701.           IF SUCCESS GOTO DISPXIT
  702.           FSAVEI        ; Restore the one stacked addr
  703.           ENDIF         ; If not 2 stored on stack, fall thru
  704.            SET IPOS S3        ; Failed... restore original pos
  705.            SOUND 100,400        ; Bronx cheer
  706.            KFLUSH            ; FLush typeahead
  707.            GOTO DISP100        ; And continue
  708.            ENDCASE
  709.       CASE "4800"                   ; Cursor up
  710.            IF N11 GT N80-12     ; If anything to scroll
  711.           SCROLL -1 9,0 N80-3,79 N99
  712.           DEC N11
  713.           ATSAY 9,0 N99    V0[N11-N80+12]
  714.            ELSE            ; Nothing to scroll
  715.           SOUND 100,400     ; Bronx cheer
  716.           ENDIF
  717.            KFLUSH            ; FLush typeahead
  718.            GOTO DISP100
  719.            ENDCASE
  720.       CASE "5000"                   ; Cursor down
  721.            IF N11 LT N10-1        ; If anything to scroll
  722.           SCROLL 1 9,0 N80-3,79 N99
  723.           INC N11
  724.           ATSAY N80-3,0 N99    V0[N11]
  725.            ELSE            ; Nothing to scroll
  726.           SOUND 100,400     ; Bronx cheer
  727.           ENDIF
  728.            KFLUSH            ; FLush typeahead
  729.            GOTO DISP100
  730.            ENDCASE
  731.       CASE "4700"                   ; Home
  732.            SCROLL 0 9,0 N80-3,79 N99
  733.            N11 = N80-12        ; Compute end line
  734.            IF N11 GE N10 N11 = N10-1; ..
  735.            SCREEN 9,0 9+N11,79 N99 V0 ; Display all at once
  736.            GOTO DISP100
  737.            ENDCASE
  738.       CASE "4400"                   ; F10
  739.            N0 = 0            ; Indicate call from Display
  740.            GOSUB Help        ; Display help screen
  741.            ENDCASE
  742.       CASE "1300"                   ; Alt-R
  743.            GOSUB Reply        ; Reply to Forum messages
  744.            ENDCASE
  745.       CASE "2100"                   ; Alt-F
  746.            MANUAL "0x2100"          ; Perform Dir cmd
  747.            ENDCASE
  748.       CASE "1000"                   ; Alt-Q
  749.            MANUAL "0x1000"          ; Edit a file
  750.            ENDCASE
  751.       CASE "7100"                   ; Alt-F10
  752.            SHELL
  753.            DWINDOW 1,0,N80-3,79    ; Reset dwindow after shell
  754.            LEGEND "_LEGEND"         ; Redo the legend
  755.            ENDCASE
  756.       DEFAULT            ; None of the above
  757.            SOUND 100,400        ; Bronx cheer
  758.            KFLUSH            ; Flush kbd
  759.            ENDCASE
  760.       ENDSWITCH
  761.     IF FLAG(0) GOTO DISPXIT     ; Return on ESC
  762.     GOTO DISP100
  763. ;
  764. ;    End of display - restore screen
  765. ;
  766. DISPXIT:
  767.     ON ESCAPE GOSUB S27        ; Set original handler
  768.     LEGEND S28            ; Set original legend
  769.     CLEAR "_DEFA"                   ; Set attrs back
  770.     RESTORE
  771.     DWIND 1,2 22,78         ; Re-Establish scrolling region
  772.     SET WRAP ON            ; line wrap at col 80 again
  773.     RETURN                ; Done with display
  774. ;
  775. ;    ESC pressed during routine
  776. ;
  777. DispEsc:
  778.     SET FLAG(0) ON            ; Flag fact
  779.     RETURN
  780. ; -----------------------------------------------------------------------
  781. ; ----- Reply: Replay to a note
  782. ;
  783. ;    Entry:    S1  -> File name carrying mail
  784. ;        S10 -> BBS-Mail record
  785. ;    Exit:    FLAG(0) is set to return to main (ESC)
  786. ;
  787. Reply:
  788.     WOPEN  8,15,10,55 (defa) DispEsc
  789.     ATSAY  8,17 (defa)  " Message Type "
  790.     ATSAY  9,17 (defa)  " Private reply (Y/N,cr=N)?"
  791.     ATSAY 10,29 (defa)  " Press ESC to cancel "
  792. ;
  793. ;    Ask for a selection
  794. ;
  795.     S0 = ""                         ; Make a NULL for loop
  796.     WHILE NULL S0
  797.           ATGET  9,44 (defa)  1 S0    ; Get resp
  798.           IF FLAG(0)        ; Exit if ESC hit
  799.          SET FLAG(0) OFF    ; Clear flag setting
  800.          WCLOSE         ; CLose open window
  801.          RETURN         ; Exit if ESC hit
  802.          ENDIF
  803.           IF NULL S0 S0 = "n"       ; Default cr=no
  804.           IF NOT FIND "YN" S0       ; Require y/n
  805.          SOUND 100,100        ; Displeased
  806.          S0 = ""                ; Force a loop
  807.          ENDIF
  808.           ENDWHILE
  809.     WCLOSE                ; CLose window
  810.     S12 = S0            ; Save private flag
  811. ;
  812. ;    Ask for a subject
  813. ;
  814.     WOPEN  8,15,11,65 (defa) DispEsc
  815.     ATSAY  8,17 (defa)  " Subject "
  816.     ATSAY  9,17 (defa)  "Enter the subject line please:"
  817.     ATSAY 11,29 (defa)  " Press ESC to cancel "
  818. ;
  819. ;    Ask for a subject
  820. ;
  821.     S0 = ""                         ; Make a NULL for loop
  822.     ATGET 10,17 (defa) 48 S0    ; Get resp
  823.     IF FLAG(0)            ; Exit if ESC hit
  824.        SET FLAG(0) OFF        ; Clear flag setting
  825.        WCLOSE            ; CLose open window
  826.        RETURN            ; Exit if ESC hit
  827.        ENDIF
  828.     IF NULL S0            ; If no response...
  829.        S0 = S10(38:77)&""           ; Default response
  830.        IF NOT FIND S10(38:47) "Reply to: " S0 = "Reply to: "*S0
  831.        ENDIF
  832.     WCLOSE                ; CLose window
  833.     S13 = S0            ; Save subject line
  834. ;
  835. ;    Construct a file name for the new message
  836. ;
  837.     N2 = 0                ; Make smallest possible date
  838.     S11 = S24&"\"*S10(8:15)&"."     ; Save fname
  839.     WHILE ISFILE S11*N2 and N2 LT 1000
  840.        INC N2            ; Move to next
  841.        ENDWHILE            ; If no error
  842.     IF N2 GE 1000
  843.        S0 = "Cannot reply... you have "*N2*" notes outstanding"
  844.        GOSUB Error
  845.        RETURN
  846.        ENDIF
  847.     S11 = S11*N2            ; Save fname to use
  848. ;
  849. ;    Build an editor batch file
  850. ;
  851.     FOPENO "BBMAINT.TMP" text       ; Try to open file
  852.     IF FAILED            ; From FOPENO above
  853.        S0 = "Error opening BBMAINT.TMP"
  854.        GOSUB Error            ; Report
  855.        RETURN            ; Return to caller
  856.        ENDIF
  857. ;
  858. ;    The first command is to open the new file
  859. ;
  860.     WRITE "edit "
  861.     S0 = S11&""                     ; Replicate
  862.     PRESERVE S0            ; Retain !s ^s and `s
  863.     WRITE S0            ; Write <fname>
  864.     WRITE "!"                       ; And a crlf
  865. ;
  866. ;    Place the header to the file
  867. ;
  868.     S0 = S10(8:15)
  869.     PRESERVE S0
  870.     WRITE "To:    "*S0
  871.     WRITE "!Insert!"
  872.     WRITE "From:  "*"Sysop"
  873.     WRITE "!Insert!"
  874.     WRITE "Date:  "*"_DATE"*"  "*"_Time"
  875.     WRITE "!Insert!"
  876.     S0 = S13
  877.     PRESERVE S0
  878.     WRITE "Subject: "*S0
  879.     WRITE "!Insert!"
  880.     WRITE "!Insert!"
  881. ;
  882. ;    If a response batch file exists, the next command executes THAT
  883. ;
  884.     IF ISFILE S24&"\BBMAINT.RES"
  885.        S0 = S24&""                  ; Replicate
  886.        PRESERVE S0            ; Retain !s ^s and `s
  887.        WRITE "@"*S0                 ; Write beginning of cmd
  888.        WRITE "\BBMAINT.RES!"        ; Write tail of cmd
  889.        GOTO REPL100         ; and continue
  890.        ENDIF
  891. ;
  892. ;    No pre-existing batch file - make one
  893. ;
  894.     WRITE "set margin 1 76!"
  895.     WRITE "set exit text!"
  896.     WRITE "Top!"
  897.     WRITE "Down!"
  898.     WRITE "Down!"
  899.     WRITE "Down!"
  900.     WRITE "Down!"
  901.     WRITE "Down!"
  902.     WRITE "Home!"
  903.     WRITE ""*S10(8:15)&", greetings!"
  904.     WRITE "Insert!"
  905.     WRITE "Insert!"
  906.     WRITE "Begin text here; margin is set to 1:76; Wordwrap and INSERT enabled.!"
  907.     WRITE "Insert!"
  908.     WRITE "Press F3 to save response; Press F4 to cancel response; F10 for help!"
  909.     WRITE "Insert!"
  910.     WRITE "Press F8 to view the original note; F8 from that window returns here.!"
  911.     WRITE "Insert!"
  912.     WRITE "Insert!"
  913.     WRITE "Sysop!"
  914.     WRITE "Top!"
  915.     WRITE "Home!"
  916.     WRITE "Down!"
  917.     WRITE "Down!"
  918.     WRITE "Down!"
  919.     WRITE "Down!"
  920.     WRITE "Down!"
  921.     WRITE "set insert!"
  922.     WRITE "^Z"
  923. ;
  924. ;    Close the batch file
  925. ;
  926. REPL100:
  927.     FCLOSEO             ; Ready to use it
  928. ;
  929. ;    Invoke the editor to write a response
  930. ;
  931.     SET TEXT N99            ; Reset Text attr
  932.     STACK "^@A@BBMAINT.TMP!"        ; ^@A -> F7; Stack batch file cmd
  933.     EDIT S1             ; Open original 1st, then "response"
  934.     SET TEXT "_DEFA"                ; Make text mode
  935.     DELETE "BBMAINT.TMP"            ; Delete temp file we created
  936.     IF NOT ISFILE S11 RETURN    ; Skip if no response text prep'd
  937. ;
  938. ;    Open the mail control file
  939. ;
  940.     FOPENO S24&"\BBS-Mail" text append
  941.     IF FAILED            ; From FOPENO above
  942.        S0 = "Error opening BBS-Mail"
  943.        GOSUB Error            ; Report
  944.        RETURN            ; Return to caller
  945.        ENDIF
  946. ;
  947. ;    Add a record to the mail file
  948. ;
  949.     S2(0:7) = S10(8:15)        ; New 'to' is old from
  950.     S2(8:15) = "SYSOP"              ; From ID
  951.     S2(16:16) = " "                 ; Privacy flag
  952.     IF FIND S12 "Y" S2(16:16) = "P" ; ..
  953.     S2(17:24) = "_DATE"             ; Set date field
  954.     S2(25:37) = S10(8:15)&"."*N2    ; FIle name
  955.     S2(38:77) = S13         ; Subject
  956.     PRESERVE S2            ; Retain !s ^s and `s
  957.     WRITE S2            ; Issue Merge command
  958.     WRITE "!"                       ; And a crlf
  959. ;
  960. ;    And we're done
  961. ;
  962.     FCLOSEO             ; Done with file
  963.     RETURN
  964. ; -----------------------------------------------------------------------
  965. ; ----- Subroutine: Help
  966. ;
  967. Help:
  968.     WOPEN  0, 0,23,78 (default) DispEsc
  969.     ATSAY  0, 2 (Default) " BBMAINT Help "
  970.     ATSAY 23,28 (Default) " Press any key to continue "
  971. ;
  972. ;    Constants for all displays
  973. ;
  974.     ATSAY  1,2 (default) "<escape>  Returns to BBMAINT main menu"
  975.     ATSAY  2,2 (default) "<return>  Moves to next message"
  976.  
  977.     ATSAY  4,2 (default) "CurUp     Scrolls text up"
  978.     ATSAY  5,2 (default) "CurDn     Scrolls text down"
  979.     ATSAY  6,2 (default) "Home      Moves to top of text"
  980.     ATSAY  7,2 (default) "PgDn      Moves to next display"
  981.     ATSAY  8,2 (default) "PgUp      Moves to previous display"
  982.  
  983.     ATSAY 10,2 (default) "Alt-F10   Shell-to-DOS"
  984.     ATSAY 11,2 (default) "Alt-F     Directory search"
  985.     ATSAY 12,2 (default) "Alt-Q     Edit a file"
  986.  
  987.     ATSAY 14,2 (default) "Alt-R     Reply to current message"
  988. ;
  989. ;    Wait for a keypress, and return
  990. ;
  991.     KEYGET S0
  992.     WCLOSE
  993.     ;
  994.     ;    ESCAPE during this screen
  995.     ;
  996.     SET FLAG(0) OFF         ; Clear flag if set
  997.     RETURN
  998. ; -----------------------------------------------------------------------
  999. ; ----- Compose: Compose and post an ad hoc note
  1000. ;
  1001. ;    Entry:    nothing
  1002. ;    Exit:    FLAG(0) is set to return to main (ESC)
  1003. ;
  1004. Compose:
  1005.     WOPEN  8,15,10,55 N99 DispEsc
  1006.     ATSAY  8,17 N99  " Addressee "
  1007.     ATSAY  9,17 N99  " To: "
  1008.     ATSAY 10,29 N99  " Press ESC to cancel "
  1009. ;
  1010. ;    Ask for a selection
  1011. ;
  1012.     S0 = ""                         ; Make a NULL for loop
  1013.     WHILE NULL S0
  1014.           ATGET  9,22 N99  8 S0    ; Get resp
  1015.           IF FLAG(0)        ; Exit if ESC hit
  1016.          SET FLAG(0) OFF    ; Clear flag setting
  1017.          WCLOSE         ; CLose open window
  1018.          RETURN         ; Exit if ESC hit
  1019.          ENDIF
  1020.           LJ S0            ; Left justify
  1021.           UPPER S0            ; Upper case it
  1022.           IF NULL S0        ; Require a name
  1023.          SOUND 100,100        ; Displeased
  1024.          S0 = ""                ; Force a loop
  1025.          ENDIF
  1026.           ENDWHILE
  1027.     WCLOSE                ; CLose window
  1028.     S10 = S0            ; Save addressee
  1029. ;
  1030. ;    Ask if private...
  1031. ;
  1032.     WOPEN  8,15,10,55 N99 DispEsc
  1033.     ATSAY  8,17 N99  " Message Type "
  1034.     ATSAY  9,17 N99  " Private reply (Y/N,cr=N)?"
  1035.     ATSAY 10,29 N99  " Press ESC to cancel "
  1036. ;
  1037. ;    Ask for a selection
  1038. ;
  1039.     S0 = ""                         ; Make a NULL for loop
  1040.     WHILE NULL S0
  1041.           ATGET  9,44 N99  1 S0    ; Get resp
  1042.           IF FLAG(0)        ; Exit if ESC hit
  1043.          SET FLAG(0) OFF    ; Clear flag setting
  1044.          WCLOSE         ; CLose open window
  1045.          RETURN         ; Exit if ESC hit
  1046.          ENDIF
  1047.           IF NULL S0 S0 = "n"       ; Default cr=no
  1048.           IF NOT FIND "YN" S0       ; Require y/n
  1049.          SOUND 100,100        ; Displeased
  1050.          S0 = ""                ; Force a loop
  1051.          ENDIF
  1052.           ENDWHILE
  1053.     WCLOSE                ; CLose window
  1054.     S11 = S0            ; Save private flag
  1055. ;
  1056. ;    Ask for a subject
  1057. ;
  1058.     WOPEN  8,15,11,65 N99 DispEsc
  1059.     ATSAY  8,17 N99  " Subject "
  1060.     ATSAY  9,17 N99  "Enter the subject line please:"
  1061.     ATSAY 11,29 N99  " Press ESC to cancel "
  1062. ;
  1063. ;    Ask for a subject
  1064. ;
  1065.     S0 = ""                         ; Make a NULL for loop
  1066.     ATGET 10,17 N99 48 S0         ; Get resp
  1067.     IF FLAG(0)            ; Exit if ESC hit
  1068.        SET FLAG(0) OFF        ; Clear flag setting
  1069.        WCLOSE            ; CLose open window
  1070.        RETURN            ; Exit if ESC hit
  1071.        ENDIF
  1072.     IF NULL S0 S0 = ".."            ; If no response...
  1073.     WCLOSE                ; CLose window
  1074.     S13 = S0            ; Save subject line
  1075. ;
  1076. ;    Construct a file name for the new message
  1077. ;
  1078.     N2 = 0                ; Make smallest possible date
  1079.     S14 = S24&"\"*S10&"."           ; Save fname
  1080.     WHILE ISFILE S14*N2 and N2 LT 1000
  1081.        INC N2            ; Move to next
  1082.        ENDWHILE            ; If no error
  1083.     IF N2 GE 1000
  1084.        S0 = "Cannot reply... you have "*N2*" notes outstanding"
  1085.        GOSUB Error
  1086.        RETURN
  1087.        ENDIF
  1088.     S14 = S14*N2            ; Save fname to use
  1089. ;
  1090. ;    Build an editor batch file
  1091. ;
  1092.     FOPENO "BBMAINT.TMP" text       ; Try to open file
  1093.     IF FAILED            ; From FOPENO above
  1094.        S0 = "Error opening BBMAINT.TMP"
  1095.        GOSUB Error            ; Report
  1096.        RETURN            ; Return to caller
  1097.        ENDIF
  1098. ;
  1099. ;    Place the header to the file
  1100. ;
  1101.     S0 = S10
  1102.     PRESERVE S0
  1103.     WRITE "To:    "*S0
  1104.     WRITE "!Insert!"
  1105.     WRITE "From:  "*"Sysop"
  1106.     WRITE "!Insert!"
  1107.     WRITE "Date:  "*"_DATE"*"  "*"_Time"
  1108.     WRITE "!Insert!"
  1109.     S0 = S13
  1110.     PRESERVE S0
  1111.     WRITE "Subject: "*S0
  1112.     WRITE "!Insert!"
  1113.     WRITE "!Insert!"
  1114. ;
  1115. ;    If a response batch file exists, the next command executes THAT
  1116. ;
  1117.     IF ISFILE S24&"\BBMAINT.MES"
  1118.        S0 = S24&""                  ; Replicate
  1119.        PRESERVE S0            ; Retain !s ^s and `s
  1120.        WRITE "@"*S0                 ; Write beginning of cmd
  1121.        WRITE "\BBMAINT.MES!"        ; Write tail of cmd
  1122.        GOTO COMP100         ; and continue
  1123.        ENDIF
  1124. ;
  1125. ;    No pre-existing batch file - make one
  1126. ;
  1127.     WRITE "set margin 1 76!"
  1128.     WRITE "set exit text!"
  1129.     WRITE "Top!"
  1130.     WRITE "Down!"
  1131.     WRITE "Down!"
  1132.     WRITE "Down!"
  1133.     WRITE "Down!"
  1134.     WRITE "Down!"
  1135.     WRITE "Home!"
  1136.     WRITE ""*S10&", greetings!"
  1137.     WRITE "Insert!"
  1138.     WRITE "Insert!"
  1139.     WRITE "Begin text here; margin is set to 1:76; Wordwrap and INSERT enabled.!"
  1140.     WRITE "Insert!"
  1141.     WRITE "Press F3 to save response; Press F4 to cancel response; F10 for help!"
  1142.     WRITE "Insert!"
  1143.     WRITE "Insert!"
  1144.     WRITE "Sysop!"
  1145.     WRITE "Top!"
  1146.     WRITE "Home!"
  1147.     WRITE "Down!"
  1148.     WRITE "Down!"
  1149.     WRITE "Down!"
  1150.     WRITE "Down!"
  1151.     WRITE "Down!"
  1152.     WRITE "set insert!"
  1153.     WRITE "^Z"
  1154. ;
  1155. ;    Close the batch file
  1156. ;
  1157. COMP100:
  1158.     FCLOSEO             ; Ready to use it
  1159. ;
  1160. ;    Invoke the editor to write a response
  1161. ;
  1162.     SET TEXT N99            ; Reset Text attr
  1163.     STACK "^@A@BBMAINT.TMP!"        ; ^@A -> F7; Stack batch file cmd
  1164.     EDIT S14            ; Open original 1st, then "response"
  1165.     SET TEXT "_DEFA"                ; Make text mode
  1166.     DELETE "BBMAINT.TMP"            ; Delete temp file we created
  1167.     IF NOT ISFILE S14 RETURN    ; Skip if no response text prep'd
  1168. ;
  1169. ;    Open the mail control file
  1170. ;
  1171.     FOPENO S24&"\BBS-Mail" text append
  1172.     IF FAILED            ; From FOPENO above
  1173.        S0 = "Error opening BBS-Mail"
  1174.        GOSUB Error            ; Report
  1175.        RETURN            ; Return to caller
  1176.        ENDIF
  1177. ;
  1178. ;    Add a record to the mail file
  1179. ;
  1180.     S2(0:7) = S10            ; New 'to' is old from
  1181.     S2(8:15) = "SYSOP"              ; From ID
  1182.     S2(16:16) = " "                 ; Privacy flag
  1183.     IF FIND S11 "Y" S2(16:16) = "P" ; ..
  1184.     S2(17:24) = "_DATE"             ; Set date field
  1185.     S2(25:37) = S10&"."*N2          ; FIle name
  1186.     S2(38:77) = S13         ; Subject
  1187.     PRESERVE S2            ; Retain !s ^s and `s
  1188.     WRITE S2            ; Issue Merge command
  1189.     WRITE "!"                       ; And a crlf
  1190. ;
  1191. ;    And we're done
  1192. ;
  1193.     FCLOSEO             ; Done with file
  1194.     RETURN
  1195.